home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 60.zip / BS1 part 60 / Highspeed pascal.adf / HSPascal / AmigaDemos / MenuUtil.pas < prev    next >
Pascal/Delphi Source File  |  1991-12-31  |  4KB  |  136 lines
  1. {--------------------------------------------------------------------------
  2.  
  3.                      HighSpeed Pascal for the Amiga
  4.  
  5.                          MENU DEMO UTILITY UNIT
  6.  
  7.                   Programmed by Martin Eskildsen 1991
  8.  
  9.                   Copyright (c) 1991 by D-House I ApS
  10.                          All rights reserved
  11.  
  12.  
  13.   Version : Date (dd.mm.yy) : Comment
  14.   -----------------------------------
  15.     1.00 : 21.07.91 : First version
  16.     1.01 : 06.11.91 : Final for first release
  17.  
  18. --------------------------------------------------------------------------}
  19.  
  20. unit MenuUtil;
  21.  
  22. INTERFACE
  23.  
  24. uses Init, Intuition, Graphics;
  25.  
  26. procedure InitMenu(var menu : pMenu; title : string);
  27. { Create new menu strip and first entry therein }
  28.  
  29. procedure AddMenu (var menu : pMenu; rootmenu : pMenu; title : string);
  30. { Add menu to menu strip }
  31.  
  32. procedure AddItem (menu : pMenu; title  : string;
  33.                                  flg    : integer;
  34.                                  mutual : longint;
  35.                                  cmdCh  : char);
  36. { Add item to given menu }
  37.  
  38. IMPLEMENTATION
  39.  
  40. procedure InitMenu(var menu : pMenu; title : string);
  41. begin
  42.   new(menu);
  43.   with menu^ do begin
  44.     NextMenu   := NIL;                       { No more menus }
  45.     LeftEdge   := 0;
  46.     TopEdge    := 0;
  47.     Width      := length(title) * 8 + 6;     { Amiga uses 8x8 std font }
  48.     Height     := 0;
  49.     Flags      := MENUENABLED;               { Yes, this menu is enabled }
  50.     MenuName   := CStrConstPtr(title);
  51.     FirstItem  := NIL                        { No items yet }
  52.   end
  53. end;
  54.  
  55. procedure AddMenu (var menu : pMenu; rootmenu : pMenu; title  : string);
  56. var
  57.   m : pMenu;
  58. begin
  59.   new(menu);
  60.  
  61.   m := rootmenu;                                { Make last menu in linked- }
  62.   while m^.NextMenu <> NIL do m := m^.NextMenu; { list point at new }
  63.   m^.NextMenu := menu;
  64.  
  65.   with menu^ do begin
  66.     NextMenu   := NIL;                          { This is last menu in list }
  67.     LeftEdge   := m^.LeftEdge + m^.Width;       { Calc position }
  68.     TopEdge    := 0;
  69.     Width      := length(title) * 8 + 6;
  70.     Height     := 0;
  71.     Flags      := MENUENABLED;
  72.     MenuName   := CStrConstPtr(title);
  73.     FirstItem  := NIL                           { No items yet }
  74.   end;
  75. end;
  76.  
  77. procedure AddItem (menu : pMenu; title  : string;
  78.                                  flg    : integer;
  79.                                  mutual : longint;
  80.                                  cmdCh  : char);
  81. var
  82.   item    : pMenuItem;        { New item }
  83.   i       : pMenuItem;
  84.   textrec : pIntuiText;       { Item title is contained in this }
  85.   MaxWid  : integer;          { Larget width in all items in this menu }
  86. begin
  87.   new(textrec);                        { Make new IntuiText for item title }
  88.   with textrec^ do begin
  89.     FrontPen  := 0;                    { Colors }
  90.     BackPen   := 1;
  91.     DrawMode  := JAM2;                 { Another of these wierd names... }
  92.     LeftEdge  := 0;
  93.     TopEdge   := 0;
  94.     ITextFont := NIL;                  { Use std. font }
  95.     IText     := CStrConstPtr(title);
  96.     NextText  := NIL                   { No more texts }
  97.   end;
  98.  
  99.   MaxWid := Max(Menu^.Width,           { Menu items are at least as wide }
  100.                 length(title) * 8 + 6);{ as the menu title (looks nice)  }
  101.   new(item);
  102.  
  103.   i := menu^.FirstItem;                   { Update linked-list and find }
  104.   if i = NIL then menu^.FirstItem := item { widest item box in the list }
  105.   else begin
  106.     while i^.NextItem <> NIL do begin
  107.       MaxWid := Max(MaxWid, i^.Width);
  108.       i := i^.NextItem
  109.     end;
  110.     i^.NextItem := item
  111.   end;
  112.  
  113.   with item^ do begin
  114.     NextItem      := NIL;              { This is last item in list }
  115.     LeftEdge      := 0;
  116.     if i = NIL then TopEdge := 0       { Calc y-position }
  117.                else TopEdge := i^.TopEdge + i^.Height + 1;
  118.     Width         := MaxWid;
  119.     Height        := 8;
  120.     Flags         := flg or ITEMTEXT;  { Always ITEMTEXT in this unit! }
  121.     MutualExclude := mutual;
  122.     ItemFill      := textrec;          { The IntuiText structure }
  123.     SelectFill    := NIL;              { No alternate image }
  124.     Command       := shortint(ord(cmdCh));   { Insert command char }
  125.     SubItem       := NIL;              { No sub menus }
  126.     NextSelect    := MENUNULL
  127.   end;
  128.   i := menu^.FirstItem;                { Make all item boxes equally wide }
  129.   while i <> NIL do begin
  130.     i^.Width := MaxWid;
  131.     i := i^.NextItem
  132.   end
  133. end;
  134.  
  135. end.
  136.